home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / parsing.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  4.5 KB  |  165 lines  |  [TEXT/R*ch]
  1. /* The PDA automaton for parsers generated by camlyacc */
  2.  
  3. #include "config.h"
  4. #include "mlvalues.h"
  5. #include "memory.h"
  6.  
  7. struct parser_tables {    /* Mirrors parse_tables in ../lib/parsing.mli */
  8.   value actions;
  9.   value transl;
  10.   char * lhs;
  11.   char * len;
  12.   char * defred;
  13.   char * dgoto;
  14.   char * sindex;
  15.   char * rindex;
  16.   char * gindex;
  17.   value tablesize;
  18.   char * table;
  19.   char * check;
  20. };
  21.  
  22. struct parser_env {       /* Mirrors parser_env in ../lib/iparsing.mli */
  23.   value s_stack;
  24.   value v_stack;
  25.   value symb_start_stack;
  26.   value symb_end_stack;
  27.   value stacksize;
  28.   value curr_char;
  29.   value lval;
  30.   value symb_start;
  31.   value symb_end;
  32.   value sp;
  33.   value rule_len;
  34.   value rule_number;
  35. };
  36.  
  37. #ifdef MOSML_BIG_ENDIAN
  38. #define Short(tbl,n) \
  39.   (*((unsigned char *)((tbl) + (n) * sizeof(short))) + \
  40.           (*((schar *)((tbl) + (n) * sizeof(short) + 1)) << 8))
  41. #else
  42. #define Short(tbl,n) (((short *)(tbl))[n])
  43. #endif
  44.  
  45. #ifdef DEBUG
  46. int parser_trace = 0;
  47. #define Trace(act) if(parser_trace) act
  48. #else
  49. #define Trace(act)
  50. #endif
  51.  
  52. /* Input codes */
  53.  
  54. #define START 0            /* Mirrors parser_input in ../lib/iparsing.mli */
  55. #define TOKEN_READ 1
  56. #define STACKS_GROWN_1 2
  57. #define STACKS_GROWN_2 3
  58. #define SEMANTIC_ACTION_COMPUTED 4
  59.  
  60. /* Output codes */
  61.  
  62. #define READ_TOKEN Atom(0) /* Mirrors parser_output in ../lib/iparsing.mli */
  63. #define RAISE_PARSE_ERROR Atom(1)
  64. #define GROW_STACKS_1 Atom(2)
  65. #define GROW_STACKS_2 Atom(3)
  66. #define COMPUTE_SEMANTIC_ACTION Atom(4)
  67.  
  68. /* The pushdown automata */
  69.  
  70. value parse_engine(tables, env, cmd, arg) /* ML */
  71.      struct parser_tables * tables;
  72.      struct parser_env * env;
  73.      value cmd;
  74.      value arg;
  75. {
  76.   static int state;
  77.   static mlsize_t sp;
  78.   int n, n1, n2, m, state1;
  79.  
  80.   switch(Tag_val(cmd)) {
  81.  
  82.   case START:
  83.     state = 0;
  84.     sp = Int_val(env->sp);
  85.  
  86.   loop:
  87.     Trace(printf("Loop %d\n", state));
  88.     n = Short(tables->defred, state);
  89.     if (n != 0) goto reduce;
  90.     if (Int_val(env->curr_char) >= 0) goto testshift;
  91.     return READ_TOKEN;
  92.                                 /* The ML code calls the lexer and updates */
  93.                                 /* symb_start and symb_end */
  94.   case TOKEN_READ:
  95.     env->curr_char = Field(tables->transl, Tag_val(arg));
  96.     if (Wosize_val(arg) == 0) {
  97.       env->lval = Val_long(0);
  98.     } else {
  99.       modify(&env->lval, Field(arg, 0));
  100.     }
  101.     Trace(printf("Token %d (0x%lx)\n", Int_val(env->curr_char), env->lval));
  102.     
  103.   testshift:
  104.     n1 = Short(tables->sindex, state);
  105.     n2 = n1 + Int_val(env->curr_char);
  106.     if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
  107.         Short(tables->check, n2) == Int_val(env->curr_char)) goto shift;
  108.     n1 = Short(tables->rindex, state);
  109.     n2 = n1 + Int_val(env->curr_char);
  110.     if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
  111.         Short(tables->check, n2) == Int_val(env->curr_char)) {
  112.       n = Short(tables->table, n2);
  113.       goto reduce;
  114.     }
  115.     return RAISE_PARSE_ERROR;
  116.                                 /* The ML code raises the Parse_error exn */
  117.   shift:
  118.     state = Short(tables->table, n2);
  119.     Trace(printf("Shift %d\n", state));
  120.     sp++;
  121.     if (sp < Long_val(env->stacksize)) goto push;
  122.     return GROW_STACKS_1;
  123.                                 /* The ML code resizes the stacks */
  124.   case STACKS_GROWN_1:
  125.   push:
  126.     Field(env->s_stack, sp) = Val_int(state);
  127.     modify(&Field(env->v_stack, sp), env->lval);
  128.     Field(env->symb_start_stack, sp) = env->symb_start;
  129.     Field(env->symb_end_stack, sp) = env->symb_end;
  130.     env->curr_char = Val_int(-1);
  131.     goto loop;
  132.  
  133.   reduce:
  134.     Trace(printf("Reduce %d\n", n));
  135.     m = Short(tables->len, n);
  136.     env->sp = Val_int(sp);
  137.     env->rule_number = Val_int(n);
  138.     env->rule_len = Val_int(m);
  139.     sp = sp - m + 1;
  140.     m = Short(tables->lhs, n);
  141.     state1 = Int_val(Field(env->s_stack, sp - 1));
  142.     n1 = Short(tables->gindex, m);
  143.     n2 = n1 + state1;
  144.     if (n1 != 0 && n2 >= 0 && n2 <= Int_val(tables->tablesize) &&
  145.         Short(tables->check, n2) == state1) {
  146.       state = Short(tables->table, n2);
  147.     } else {
  148.       state = Short(tables->dgoto, m);
  149.     }
  150.     if (sp < Long_val(env->stacksize)) goto semantic_action;
  151.     return GROW_STACKS_2;
  152.                                 /* The ML code resizes the stacks */
  153.   case STACKS_GROWN_2:
  154.   semantic_action:
  155.     return COMPUTE_SEMANTIC_ACTION;
  156.                                 /* The ML code calls the semantic action */
  157.   case SEMANTIC_ACTION_COMPUTED:
  158.     Field(env->s_stack, sp) = Val_int(state);
  159.     modify(&Field(env->v_stack, sp), arg);
  160.     Field(env->symb_end_stack, sp) =
  161.       Field(env->symb_end_stack, Int_val(env->sp));
  162.     goto loop;
  163.   }
  164. }
  165.